home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRIC / DSPICE0S.ZIP / ntrpl8.c < prev    next >
C/C++ Source or Header  |  1992-11-22  |  8KB  |  279 lines
  1. /* ntrpl8.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  26.         sfactr;
  27.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  28.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  29. } status_;
  30.  
  31. #define status_1 status_
  32.  
  33. struct {
  34.     doublereal xincr, string[15], xstart, yvar[8];
  35.     integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
  36. } outinf_;
  37.  
  38. #define outinf_1 outinf_
  39.  
  40. struct {
  41.     doublereal value[200000];
  42. } blank_;
  43.  
  44. #define blank_1 blank_
  45.  
  46. /*<       subroutine ntrpl8(locx,locy,numpnt) >*/
  47. /* Subroutine */ int ntrpl8_(locx, locy, numpnt)
  48. integer *locx, *locy, *numpnt;
  49. {
  50.     /* System generated locals */
  51.     integer i_1, i_2;
  52.     doublereal d_1, d_2;
  53.  
  54.     /* Local variables */
  55.     static integer loco;
  56.     static doublereal dx1x2, xvar;
  57.     static integer loco1, loco2, i, k, icpnt, locyt, ippnt;
  58.     static doublereal v1, v2, x1, x2, xvtol;
  59. #define nodplc ((integer *)&blank_1)
  60. #define cvalue ((complex *)&blank_1)
  61.     static doublereal tol, yvr, dxx1;
  62.  
  63. /*<       implicit double precision (a-h,o-z) >*/
  64.  
  65. /*     this routine interpolates the analysis data to obtain the values */
  66.  
  67. /* printed and/or plotted, using linear interpolation. */
  68.  
  69. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  70. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  71. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  72. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  73. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  74. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  75. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  76. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  77. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  78. /* spice version 2g.6  sccsid=status 3/15/83 */
  79. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  80. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  81. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  82. /* spice version 2g.6  sccsid=outinf 3/15/83 */
  83. /*<       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
  84. /*<      1   ilogy(8),npoint,numout,kntr,numdgt >*/
  85. /* spice version 2g.6  sccsid=blank 3/15/83 */
  86. /*<       common /blank/ value(200000) >*/
  87. /*<       integer nodplc(64) >*/
  88. /*<       complex cvalue(32) >*/
  89. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  90.  
  91.  
  92. /*  for dc transfer curve, no interpolation necessary */
  93.  
  94. /*<       if(mode.ne.1) go to 4 >*/
  95.     if (status_1.mode != 1) {
  96.     goto L4;
  97.     }
  98. /*<       numpnt=icalc >*/
  99.     *numpnt = status_1.icalc;
  100. /*<       loco=loutpt >*/
  101.     loco = tabinf_1.loutpt;
  102. /*<       do 3 i=1,numpnt >*/
  103.     i_1 = *numpnt;
  104.     for (i = 1; i <= i_1; ++i) {
  105. /*<       locyt=locy >*/
  106.     locyt = *locy;
  107. /*<       value(locx+i)=value(loco+1) >*/
  108.     blank_1.value[*locx + i - 1] = blank_1.value[loco];
  109. /*<       do 2 k=1,kntr >*/
  110.     i_2 = outinf_1.kntr;
  111.     for (k = 1; k <= i_2; ++k) {
  112. /*<       iseq=itab(k) >*/
  113.         tabinf_1.iseq = outinf_1.itab[k - 1];
  114. /*<       iseq=nodplc(iseq+4) >*/
  115.         tabinf_1.iseq = nodplc[tabinf_1.iseq + 3];
  116. /*<       value(locyt+i)=value(loco+iseq) >*/
  117.         blank_1.value[locyt + i - 1] = blank_1.value[loco + tabinf_1.iseq 
  118.             - 1];
  119. /*<       locyt=locyt+npoint >*/
  120.         locyt += outinf_1.npoint;
  121. /*<     2 continue >*/
  122. /* L2: */
  123.     }
  124. /*<       loco=loco+numout >*/
  125.     loco += outinf_1.numout;
  126. /*<     3 continue >*/
  127. /* L3: */
  128.     }
  129. /*<       return >*/
  130.     return 0;
  131. /*<     4 continue >*/
  132. L4:
  133. /*<       xvar=xstart >*/
  134.     xvar = outinf_1.xstart;
  135. /*<       xvtol=xincr*1.0d-5 >*/
  136.     xvtol = outinf_1.xincr * 1e-5;
  137. /*<       ippnt=0 >*/
  138.     ippnt = 0;
  139. /*<       icpnt=2 >*/
  140.     icpnt = 2;
  141. /*<       loco1=loutpt >*/
  142.     loco1 = tabinf_1.loutpt;
  143. /*<       loco2=loco1+numout >*/
  144.     loco2 = loco1 + outinf_1.numout;
  145. /*<       if (icalc.lt.2) go to 50 >*/
  146.     if (status_1.icalc < 2) {
  147.     goto L50;
  148.     }
  149. /*<    10 x1=value(loco1+1) >*/
  150. L10:
  151.     x1 = blank_1.value[loco1];
  152. /*<       x2=value(loco2+1) >*/
  153.     x2 = blank_1.value[loco2];
  154. /*<       dx1x2=x1-x2 >*/
  155.     dx1x2 = x1 - x2;
  156. /*<    20 if (xincr.lt.0.0d0) go to 24 >*/
  157. L20:
  158.     if (outinf_1.xincr < 0.) {
  159.     goto L24;
  160.     }
  161. /*<       if (xvar.le.(x2+xvtol)) go to 30 >*/
  162.     if (xvar <= x2 + xvtol) {
  163.     goto L30;
  164.     }
  165. /*<       go to 28 >*/
  166.     goto L28;
  167. /*<    24 if (xvar.ge.(x2+xvtol)) go to 30 >*/
  168. L24:
  169.     if (xvar >= x2 + xvtol) {
  170.     goto L30;
  171.     }
  172. /*<    28 if (icpnt.ge.icalc) go to 100 >*/
  173. L28:
  174.     if (icpnt >= status_1.icalc) {
  175.     goto L100;
  176.     }
  177. /*<       icpnt=icpnt+1 >*/
  178.     ++icpnt;
  179. /*<       loco1=loco2 >*/
  180.     loco1 = loco2;
  181. /*<       loco2=loco1+numout >*/
  182.     loco2 = loco1 + outinf_1.numout;
  183. /*<       go to 10 >*/
  184.     goto L10;
  185. /*<    30 ippnt=ippnt+1 >*/
  186. L30:
  187.     ++ippnt;
  188. /*<       value(locx+ippnt)=xvar >*/
  189.     blank_1.value[*locx + ippnt - 1] = xvar;
  190. /*<       dxx1=xvar-x1 >*/
  191.     dxx1 = xvar - x1;
  192. /*<       locyt=locy >*/
  193.     locyt = *locy;
  194. /*<       do 40 i=1,kntr >*/
  195.     i_1 = outinf_1.kntr;
  196.     for (i = 1; i <= i_1; ++i) {
  197. /*<       iseq=itab(i) >*/
  198.     tabinf_1.iseq = outinf_1.itab[i - 1];
  199. /*<       iseq=nodplc(iseq+4) >*/
  200.     tabinf_1.iseq = nodplc[tabinf_1.iseq + 3];
  201. /*<       v1=value(loco1+iseq) >*/
  202.     v1 = blank_1.value[loco1 + tabinf_1.iseq - 1];
  203. /*<       v2=value(loco2+iseq) >*/
  204.     v2 = blank_1.value[loco2 + tabinf_1.iseq - 1];
  205. /*<       yvr=v1+(v1-v2)*dxx1/dx1x2 >*/
  206.     yvr = v1 + (v1 - v2) * dxx1 / dx1x2;
  207. /*<       tol=dmin1(dabs(v1),dabs(v2))*1.0d-10 >*/
  208. /* Computing MAX */
  209.     d_1 = abs(v1), d_2 = abs(v2);
  210.     tol = min(d_2,d_1) * 1e-10;
  211. /*<       if (dabs(yvr).le.tol) yvr=0.0d0 >*/
  212.     if (abs(yvr) <= tol) {
  213.         yvr = 0.;
  214.     }
  215. /*<       value(locyt+ippnt)=yvr >*/
  216.     blank_1.value[locyt + ippnt - 1] = yvr;
  217. /*<       locyt=locyt+npoint >*/
  218.     locyt += outinf_1.npoint;
  219. /*<    40 continue >*/
  220. /* L40: */
  221.     }
  222. /*<       if (ippnt.ge.npoint) go to 100 >*/
  223.     if (ippnt >= outinf_1.npoint) {
  224.     goto L100;
  225.     }
  226. /*<       xvar=xstart+dble(ippnt)*xincr >*/
  227.     xvar = outinf_1.xstart + (doublereal) ippnt * outinf_1.xincr;
  228. /*<       if (dabs(xvar).ge.dabs(xvtol)) go to 20 >*/
  229.     if (abs(xvar) >= abs(xvtol)) {
  230.     goto L20;
  231.     }
  232. /*<       xvar=0.0d0 >*/
  233.     xvar = 0.;
  234. /*<       go to 20 >*/
  235.     goto L20;
  236.  
  237. /*  special handling if icalc = 1 */
  238.  
  239. /* ...  icalc=1;  just copy over the single point and return */
  240. /*<    50 ippnt=1 >*/
  241. L50:
  242.     ippnt = 1;
  243. /*<       value(locx+ippnt)=xvar >*/
  244.     blank_1.value[*locx + ippnt - 1] = xvar;
  245. /*<       locyt=locy >*/
  246.     locyt = *locy;
  247. /*<       do 60 i=1,kntr >*/
  248.     i_1 = outinf_1.kntr;
  249.     for (i = 1; i <= i_1; ++i) {
  250. /*<       iseq=itab(i) >*/
  251.     tabinf_1.iseq = outinf_1.itab[i - 1];
  252. /*<       iseq=nodplc(iseq+4) >*/
  253.     tabinf_1.iseq = nodplc[tabinf_1.iseq + 3];
  254. /*<       value(locyt+ippnt)=value(loco1+iseq) >*/
  255.     blank_1.value[locyt + ippnt - 1] = blank_1.value[loco1 + 
  256.         tabinf_1.iseq - 1];
  257. /*<       locyt=locyt+npoint >*/
  258.     locyt += outinf_1.npoint;
  259. /*<    60 continue >*/
  260. /* L60: */
  261.     }
  262. /*<       go to 100 >*/
  263.     goto L100;
  264.  
  265. /*  return */
  266.  
  267. /*<   100 numpnt=ippnt >*/
  268. L100:
  269.     *numpnt = ippnt;
  270. /*<       return >*/
  271.     return 0;
  272. /*<       end >*/
  273. } /* ntrpl8_ */
  274.  
  275. #undef cvalue
  276. #undef nodplc
  277.  
  278.  
  279.